home *** CD-ROM | disk | FTP | other *** search
/ MacGames Sampler / PHT MacGames Bundle.iso / MacSource Folder / Samples from the CD / Pascal / Source□ / Talk Source / Talk ƒ / TalkUDPPackets.p < prev    next >
Encoding:
Text File  |  1992-04-20  |  8.7 KB  |  341 lines  |  [TEXT/PJMM]
  1. unit TalkUDPPackets;
  2.  
  3. { This program was written by Peter N Lewis, Mar 1992 in THINK Pascal 4.0.1 }
  4.  
  5. interface
  6.  
  7.     uses
  8.         TalkdTypes;
  9.  
  10.     type
  11.         whenType = (WT_Now, WT_Soon, WT_Delayed);
  12.  
  13.     function InitUDPPackets: OSErr;
  14. { procedure HandleReceive(data:univ longInt; request,response:ctlMsg)}
  15.     procedure FinishUDPPackets;
  16.     function CreateUDPChannel (data: univ longInt; id: longInt; var localport: integer): OSErr;
  17.     procedure SendPacket (data: univ longInt; when: whenType; var request: ctlMsg; remoteIP: longInt; remoteport: integer);
  18.     procedure DestroyUDPChannel (data: univ longInt);
  19.     function ReceivePacket (var data: univ longInt; var request, response: ctlMsg): boolean;
  20.     function FindRequest (id: longInt; var data: univ longInt): boolean;
  21.     procedure SendOnePacket (var request: ctlMsg; remoteIP: longInt; remoteport: integer);
  22.  
  23. implementation
  24.  
  25.     uses
  26.         UDPStuff, MyLists;
  27.  
  28.     const
  29.         k_resend_delay = 60 * 2; { two seconds }
  30.         k_daemon_delay = 60 * 2; { delay between calling SendPacket and sending to a delayed port }
  31.  
  32.     type
  33.         packetRecord = record
  34.                 udpc: UDPConnectionPtr;
  35.                 dead: boolean;
  36.                 data: longInt;
  37.                 id: longInt;
  38.                 refreshtime: longInt;
  39.                 remoteIP: longInt;
  40.                 remoteport: integer;
  41.                 cvt: longInt;
  42.                 firstsend: boolean;
  43.                 request: ctlMsg;
  44.             end;
  45.         packetPtr = ^packetRecord;
  46.  
  47.     var
  48.         udplist: listHead;
  49.  
  50.     function InitUDPPackets: OSErr;
  51.     begin
  52.         InitUDPPackets := noErr;
  53.         CreateList(udplist);
  54.     end;
  55.  
  56.     procedure DestroyChannel (item: listItem);
  57.         var
  58.             prp: packetPtr;
  59.             oe: OSErr;
  60.     begin
  61.         DeleteItem(item, prp);
  62.         oe := UDPRelease(prp^.udpc);
  63.         DisposPtr(ptr(prp));
  64.     end;
  65.  
  66.     procedure FinishUDPPackets;
  67.         var
  68.             oe: OSErr;
  69.             item: listItem;
  70.     begin
  71.         while not IsEmpty(udplist) do begin
  72.             ReturnHead(udplist, item);
  73.             DestroyChannel(item);
  74.         end;
  75.         DestroyList(udplist, false);
  76.     end;
  77.  
  78.     function CreateUDPChannelP (data: univ longInt; id: longInt; var localport: integer; var prp: packetPtr): OSErr;
  79.         var
  80.             udpc: UDPConnectionPtr;
  81.             oe: OSErr;
  82.     begin
  83.         oe := UDPCreateDynamic(udpc, 0, localport);
  84.         if oe = noErr then begin
  85.             prp := packetPtr(Newptr(SizeOf(packetRecord)));
  86.             prp^.udpc := udpc;
  87.             prp^.dead := true;
  88.             prp^.data := data;
  89.             prp^.id := id;
  90.             prp^.cvt := 0;
  91.             AddTail(udplist, prp);
  92.         end;
  93.         CreateUDPChannelP := oe;
  94.     end;
  95.  
  96.     function CreateUDPChannel (data: univ longInt; id: longInt; var localport: integer): OSErr;
  97.         var
  98.             prp: packetPtr;
  99.     begin
  100.         CreateUDPChannel := CreateUDPChannelP(data, id, localport, prp);
  101.     end;
  102.  
  103. { cvt 0=bsd 4.3, 1=sun/bsd 4.2 }
  104.     procedure NToORequest (cvt: longInt; var request, orequest: ctlMsg; var datalen: integer; var dstport: integer);
  105.         var
  106.             ocr: octlMsg;
  107.             i: integer;
  108.     begin
  109.         case cvt of
  110.             0:  begin
  111.                 orequest := request;
  112.                 datalen := SizeOf(ctlMsg);
  113.                 dstport := talkd_port;
  114.             end;
  115.             1:  begin
  116.                 ocr.data[1] := chr(ord(request.typ));
  117.                 BlockMove(@request.l_name, @ocr.data[2], oname_size);
  118.                 ocr.data[10] := chr(0);
  119.                 BlockMove(@request.r_name, @ocr.data[11], oname_size);
  120.                 ocr.data[19] := chr(0);
  121.                 ocr.data[20] := chr(0);
  122.                 ocr.pid := request.pid;
  123.                 ocr.id_num := request.id_num;
  124.                 ocr.r_tty := request.r_tty;
  125.                 ocr.addr := request.addr;
  126.                 ocr.ctl_addr := request.ctl_addr;
  127.                 datalen := SizeOf(octlMsg);
  128.                 BlockMove(@ocr, @orequest, datalen);
  129.                 dstport := otalkd_port;
  130.                 if request.typ = CT_Delete then
  131.                     cvt := cvt;
  132.             end;
  133.         end;
  134.     end;
  135.  
  136.     procedure OToNResponse (cvt: longInt; remoteport: integer; datap: ptr; datalen: integer; var response: ctlMsg);
  137.         var
  138.             ocr: octlResponse;
  139.             ocrs: octlResponseSmall;
  140.     begin
  141.         if cvt = 1 then
  142.             cvt := cvt;
  143.         response.vers := -1;
  144.         if remoteport = otalkd_port then begin
  145.             if cvt = 1 then begin
  146.                 if datalen = SizeOf(octlResponse) then begin
  147.                     BlockMove(datap, @ocr, datalen);
  148.                     if (0 <= ord(ocr.typ)) and (ord(ocr.typ) <= 3) then
  149.                         response.vers := talk_version;
  150.                     response.typ := ocr.typ;
  151.                     response.answer := ocr.answer;
  152.                     response.id_num := ocr.id_num;
  153.                     response.addr := ocr.addr;
  154.                 end
  155.                 else if datalen = SizeOf(octlResponseSmall) then begin
  156.                     BlockMove(datap, @ocrs, datalen);
  157.                     if (0 <= ord(ocrs.typ)) and (ord(ocrs.typ) <= 3) then
  158.                         response.vers := talk_version;
  159.                     response.typ := ocrs.typ;
  160.                     response.answer := ocrs.answer;
  161.                     response.id_num := ocrs.id_num;
  162.                     response.addr := ocrs.addr;
  163.                 end;
  164.             end;
  165.         end
  166.         else begin
  167.             if (datalen = SizeOf(ctlMsg)) or (datalen = SizeOf(ctlResponse)) then
  168.                 BlockMove(datap, @response, datalen);
  169.         end;
  170.     end;
  171.  
  172.     function FindRequest (id: longInt; var data: univ longInt): boolean;
  173.         var
  174.             item: listItem;
  175.             prp: packetPtr;
  176.     begin
  177.         FindRequest := false;
  178.         ReturnHead(udplist, item);
  179.         while not IsTail(item) do begin
  180.             Fetch(item, prp);
  181.             if prp^.id = id then begin
  182.                 data := prp^.data;
  183.                 FindRequest := true;
  184.                 leave;
  185.             end;
  186.             MoveToNext(item);
  187.         end;
  188.     end;
  189.  
  190.     function Find (data: longInt; var item: listItem; var prp: packetPtr): boolean;
  191.     begin
  192.         Find := false;
  193.         ReturnHead(udplist, item);
  194.         while not IsTail(item) do begin
  195.             Fetch(item, prp);
  196.             if prp^.data = data then begin
  197.                 Find := true;
  198.                 leave;
  199.             end;
  200.             MoveToNext(item);
  201.         end;
  202.     end;
  203.  
  204.     procedure DestroyUDPChannel (data: univ longInt);
  205.         var
  206.             item: listItem;
  207.             prp: packetPtr;
  208.     begin
  209.         if Find(data, item, prp) then begin
  210.             DestroyChannel(item);
  211.         end;
  212.     end;
  213.  
  214.     procedure DestroyUDPChannelP (prp: packetPtr);
  215.         var
  216.             item: listItem;
  217.     begin
  218.         if FindItem(udplist, prp, item) then begin
  219.             DestroyChannel(item);
  220.         end;
  221.     end;
  222.  
  223.     procedure SendPacketP (prp: packetPtr; when: whenType; var request: ctlMsg; remoteIP: longInt; remoteport: integer);
  224.         var
  225.             oe: OSErr;
  226.     begin
  227.         prp^.dead := false;
  228.         if when <> WT_Soon then
  229.             prp^.refreshtime := TickCount + k_daemon_delay
  230.         else
  231.             prp^.refreshtime := TickCount - 1;
  232.         prp^.request := request;
  233.         prp^.remoteIP := remoteIp;
  234.         prp^.remoteport := remoteport;
  235.         prp^.firstsend := true;
  236.         prp^.cvt := 0;
  237.         if when = WT_Now then begin
  238.             oe := UDPWrite(prp^.udpc, prp^.remoteIP, prp^.remoteport, @prp^.request, SizeOf(ctlMsg), false);
  239.         end;
  240.     end;
  241.  
  242.     procedure SendPacket (data: univ longInt; when: whenType; var request: ctlMsg; remoteIP: longInt; remoteport: integer);
  243.         var
  244.             item: listItem;
  245.             prp: packetPtr;
  246.             oe: OSErr;
  247.     begin
  248.         if Find(data, item, prp) then begin
  249.             SendPacketP(prp, when, request, remoteIP, remoteport);
  250.         end;
  251.     end;
  252.  
  253.     procedure SendOnePacket (var request: ctlMsg; remoteIP: longInt; remoteport: integer);
  254.         var
  255.             prp: packetPtr;
  256.     begin
  257.         if CreateUDPChannelP(0, 0, request.ctl_addr.port, prp) = noErr then begin
  258.             SendPacketP(prp, WT_Now, request, remoteIP, remoteport);
  259.         end;
  260.     end;
  261.  
  262.     function FindIP (remoteIP: longInt; remoteport: integer; var prp: packetPtr): boolean;
  263.         var
  264.             item: listItem;
  265.     begin
  266.         FindIP := false;
  267.         ReturnHead(udplist, item);
  268.         while not IsTail(item) do begin
  269.             Fetch(item, prp);
  270.             if (prp^.remoteIP = remoteIP) and (prp^.remoteport = remoteport) then begin
  271.                 FindIP := true;
  272.                 leave;
  273.             end;
  274.             MoveToNext(item);
  275.         end;
  276.     end;
  277.  
  278.     function ReceivePacket (var data: univ longInt; var request, response: ctlMsg): boolean;
  279.         var
  280.             item: listItem;
  281.             prp: packetptr;
  282.             datap: ptr;
  283.             datalen: integer;
  284.             remoteIP: longInt;
  285.             remoteport: integer;
  286.             dstport: integer;
  287.             ocr: ctlMsg;
  288.             oe: OSErr;
  289.     begin
  290.         ReturnHead(udplist, item);
  291.         while not IsTail(item) do begin
  292.             Fetch(item, prp);
  293.             if UDPDatagramsAvailable(prp^.udpc) > 0 then begin
  294.                 oe := UDPRead(prp^.udpc, 2, remoteIP, remoteport, datap, datalen);
  295.                 if oe <> noErr then
  296.                     leave;
  297.                 if remoteIP <> $86073203 then
  298.                     prp := prp;
  299.                 if datalen > 0 then begin
  300.                     OToNResponse(prp^.cvt, remoteport, datap, datalen, response);
  301.                     oe := UDPReturnBuffer(prp^.udpc, datap);
  302.                     if prp^.data = 0 then begin
  303.                         DestroyUDPChannelP(prp);
  304.                         leave;
  305.                     end
  306.                     else begin
  307.                         if (prp^.request.typ = response.typ) and (prp^.request.vers = response.vers) and (not prp^.dead) then begin
  308.                             ReceivePacket := true;
  309.                             data := prp^.data;
  310.                             prp^.dead := true;
  311.                             request := prp^.request;
  312.                             Exit(ReceivePacket);
  313.                         end;
  314.                     end;
  315.                 end;
  316.             end;
  317.             MoveToNext(item);
  318.         end;
  319.         ReturnHead(udplist, item);
  320.         while not IsTail(item) do begin
  321.             Fetch(item, prp);
  322.             if (TickCount > prp^.refreshtime) and (not prp^.dead) then begin
  323.                 if prp^.firstsend then
  324.                     prp^.firstsend := false
  325.                 else if prp^.remoteport = talkd_port then
  326.                     prp^.cvt := 1;
  327.                 oe := UDPWrite(prp^.udpc, prp^.remoteIP, prp^.remoteport, @prp^.request, SizeOf(ctlMsg), false);
  328.                 if prp^.cvt = 1 then begin
  329.                     NToORequest(prp^.cvt, prp^.request, ocr, datalen, dstport);
  330.                     if prp^.request.typ = CT_Delete then
  331.                         prp := prp;
  332.                     oe := UDPWrite(prp^.udpc, prp^.remoteIP, dstport, @ocr, datalen, false);
  333.                 end;
  334.                 prp^.refreshtime := TickCount + k_resend_delay;
  335.             end;
  336.             MoveToNext(item);
  337.         end;
  338.         ReceivePacket := false;
  339.     end;
  340.  
  341. end.